home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp1.arc / GETUPLOA.PAS < prev    next >
Pascal/Delphi Source File  |  1985-09-26  |  6KB  |  171 lines
  1. (*----------------------------------------------------------------------*)
  2. (*       Get_Upload_Protocol --- Get Upload File Transfer Protocol      *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION Get_Upload_Protocol : Transfer_Type ;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Function:   Get_Upload_Protocol                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Gets file name and transfer protocol for upload.     *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Transtyp := Get_Upload_Protocol: Transfer_Type;               *)
  16. (*                                                                      *)
  17. (*     Remarks:                                                         *)
  18. (*                                                                      *)
  19. (*     Calls:    KeyPressed                                             *)
  20. (*               Async_Send                                             *)
  21. (*               Async_Receive                                          *)
  22. (*                                                                      *)
  23. (*----------------------------------------------------------------------*)
  24.  
  25. VAR
  26.    Transfer_Kind : Transfer_Type;
  27.    Transfer_Menu : Menu_Type;
  28.    I             : INTEGER;
  29.    Pacing_String : STRING[1];
  30.    Ch            : CHAR;
  31.    Flag          : BOOLEAN;
  32.  
  33. BEGIN (* Get_Upload_Protocol *)
  34.  
  35.    Get_Upload_Protocol := None;
  36.  
  37.    WITH Transfer_Menu DO
  38.       BEGIN
  39.  
  40.          Menu_Size    := 9;
  41.  
  42.          Menu_Default := ORD( Default_Transfer_Type ) + 1;
  43.          IF Menu_Default > 9 THEN Menu_Default := 1;
  44.  
  45.          Menu_Row     := 5;
  46.          Menu_Column  := 20;
  47.          Menu_Tcolor  := Menu_Text_Color;
  48.          Menu_Bcolor  := BackGround_Color;
  49.          Menu_Fcolor  := Menu_Frame_Color;
  50.          Menu_Width   := 50;
  51.          Menu_Height  := 18;
  52.  
  53.       END;
  54.  
  55.    FOR I := 1 TO 9 DO
  56.       WITH Transfer_Menu.Menu_Entries[I] DO
  57.       BEGIN
  58.          Menu_Item_Row    := I;
  59.          Menu_Item_Column := 2;
  60.          CASE I OF
  61.             1:  Menu_Item_Text := 'a) Ascii';
  62.             2:  Menu_Item_Text := 'b) Xmodem (Checksum)';
  63.             3:  Menu_Item_Text := 'c) Xmodem (CRC)';
  64.             4:  Menu_Item_Text := 'd) Kermit';
  65.             5:  Menu_Item_Text := 'e) Telink';
  66.             6:  Menu_Item_Text := 'f) Modem7 (Checksum)';
  67.             7:  Menu_Item_Text := 'g) Modem7 (CRC)';
  68.             8:  Menu_Item_Text := 'h) Ymodem';
  69.             9:  Menu_Item_Text := 'i) Ymodem (Batch)';
  70.          END (* Case *);
  71.       END;
  72.  
  73.    Transfer_Menu.Menu_Title := 'Choose file transfer protocol for upload:';
  74.  
  75.    Menu_Display_Choices( Transfer_Menu );
  76.    Transfer_Kind := Transfers[ Menu_Get_Choice( Transfer_Menu ,
  77.                                                 Dont_Erase_Menu ) ];
  78.  
  79.    IF ( Transfer_Kind <> Kermit ) THEN
  80.       BEGIN
  81.          GoToXY( 2 , 11 );
  82.          WRITE('Filename.Ext ? ');
  83.          READLN(FileName);
  84.       END;
  85.  
  86.    IF Transfer_Kind IN [ Xmodem_Chk, Xmodem_Crc, Ascii, Ymodem ] THEN
  87.       BEGIN
  88.  
  89.          ASSIGN(AFile,FileName);
  90.             (*$I- *)
  91.          RESET(AFile);
  92.             (*$I+ *)
  93.  
  94.          IF Int24Result <> 0 THEN
  95.             BEGIN
  96.                Transfer_Kind := None;
  97.                WRITELN('*** File to send doesn''t exist, upload cancelled ***');
  98.             END;
  99.  
  100.       END;
  101.                                    (* Get delays for Ascii transfers *)
  102.    Char_Delay := 0;
  103.    Line_Delay := 0;
  104.  
  105.    CASE Transfer_Kind OF
  106.  
  107.       Xmodem_Crc,
  108.       Xmodem_Chk,
  109.       Ymodem      :     (*$I-*)
  110.                      CLOSE( AFile );
  111.                         (*$I+*)
  112.  
  113.       Ascii       :  BEGIN
  114.  
  115.                         GoToXY( 2 , 12 );
  116.                         WRITE('Delay between characters (milliseconds)? ');
  117.                         READLN( Char_Delay );
  118.  
  119.                         GoToXY( 2 , 13 );
  120.                         WRITE('Delay between lines (milleseconds)?      ');
  121.                         READLN( Line_Delay );
  122.  
  123.                         GoToXY( 2 , 14 );
  124.                         WRITE('Pacing character?                        ');
  125.                         READLN( Pacing_String );
  126.  
  127.                         IF LENGTH( Pacing_String ) > 0 THEN
  128.                            Pacing_Char := Pacing_String[1]
  129.                         ELSE
  130.                            Pacing_Char := CHR( NUL );
  131.  
  132.                         REPEAT
  133.                            GoToXY( 2 , 15 );
  134.                            WRITE('End each line with  a) CR or  b) CR+LF   ');
  135.                            ClrEol;
  136.                            READ( Kbd , Ch );
  137.                            WRITE( Ch );
  138.                            Ch := UpCase( Ch );
  139.                         UNTIL( Ch IN ['A','B'] );
  140.  
  141.                         IF Ch = 'A' THEN
  142.                            CR_LF_String := CHR( CR )
  143.                         ELSE
  144.                            CR_LF_String := CHR( CR ) + CHR( LF );
  145.  
  146.                         GoToXY( 2 , 16 );
  147.                         WRITE('Hit ALT-S to stop transfer.');
  148.  
  149.                            (*$I-*)
  150.                         CLOSE( Afile );
  151.                            (*$I+*)
  152.  
  153.                      END;
  154.  
  155.       None        : ;
  156.  
  157.       ELSE        ;
  158.  
  159.    END (* CASE *);
  160.  
  161.                                    (* Return transfer protocol type *)
  162.    Get_Upload_Protocol := Transfer_Kind;
  163.  
  164.    DELAY( Two_Second_Delay );
  165.                                    (* Remove this window            *)
  166.    Restore_Screen( Saved_Screen );
  167.  
  168.    Reset_Global_Colors;
  169.  
  170. END   (* Get_Upload_Protocol *);
  171.